home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Franz PD
/
Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).zip
/
Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).adf
/
GFA.Anwendung
/
ICONTYP.LST
< prev
next >
Wrap
File List
|
1992-09-14
|
5KB
|
133 lines
REM *********************************
REM * Icontyp 1.00 *
REM * © 26.4.1992 by Henry König *
REM * Bornheide 71, 2000 Hamburg 53 *
REM *********************************
init ! Bildschirm und Fenster öffnen
icon.wechseln ! Hauptprozedur
CLOSES 1 ! Bildschirm schließen
CLOSEW #1 ! Fenster schließen
END ! und zurück zur WB
PROCEDURE icon.wechseln ! die Hauptprozedur
y$="j" ! Eingangswert für die Schleife
WHILE y$="j" !
programmkopf
PRINT AT(14,28);"© 1992 by Henry König, Bornheide 71, 2000 Hamburg 53."
PRINT AT(24,31);"Icons (Piktogramme) enden mit '.info'."
programmauswahl("Icon wählen","OK",pfad$,dateiname$)
IF abbruch%=0 THEN
programmkopf
PRINT AT(2,5);"Icontypen: Icon-Name: ";dateiname$
PRINT AT(2,6);"---------- aktueller Icontyp wird gelb markiert."
PRINT AT(2,10);"1 - Disketten"
PRINT AT(2,12);"2 - Drawer (Schubladen)"
PRINT AT(2,14);"3 - Tool (Programme)"
PRINT AT(2,16);"4 - Projekt (Texte und Scriptdateien)"
PRINT AT(2,18);"5 - Garbage (Mülleimer)"
OPEN "R",#1,pfad$+dateiname$,1 ! Icon als rel. Datei öffnen
FIELD #1,1 AS icon$
GET #1,49 ! Icontyp lesen
it%=ASC(icon$)
PCOLOR 5,0 ! gelb
SELECT it%
CASE 1
PRINT AT(2,10);"1 - Disketten"
CASE 2
PRINT AT(2,12);"2 - Drawer (Schubladen)"
CASE 3
PRINT AT(2,14);"3 - Tool (Programme)"
CASE 4
PRINT AT(2,16);"4 - Projekt (Texte und Scriptdateien)"
CASE 5
PRINT AT(2,18);"5 - Garbage (Mülleimer)"
ENDSELECT
PCOLOR 1,0
PRINT AT(2,20);"0 - Abruch"
PRINT AT(2,22);"Ihre Wahl --> ";
INPUT x$ ! Typ abfragen
x%=VAL(x$) ! Typ nach Ziffern wandeln
IF x%<1 OR x%>5 THEN ! ungültiger Typ
abbruch%=1 ! dann Abbruchflag setzen
ELSE
LSET icon$=CHR$(x%) ! neue Kennung schreiben
PUT #1,49 ! Icontyp schreiben
ENDIF
CLOSE #1 ! Datei (Icon) wieder schließen
ENDIF
programmfuss ! letzte Anweisung ausblenden
PRINT AT(4,28);"Noch ein Icontyp ändern (j/n): ";
INPUT y$ !
WEND
RETURN
PROCEDURE programmkopf ! Bildschirm löschen u. Programmnamen ausgeben
CLS
COLOR 2 ! schwarze Box
PBOX 1,1,639,20
COLOR 0 ! grau
PBOX 6,4,633,17
COLOR 4 ! hellgrau
LINE 6,4,633,4
LINE 6,4,6,17
PRINT AT(2,2);SPACE$(78)
PCOLOR 5,0
PRINT AT(25,2);"Ändern der Icontypen (Piktogramme)"
PCOLOR 1,0
programmfuss
RETURN
PROCEDURE programmfuss ! Anweisungsboxen zeichnen
COLOR 2 ! schwarz
PBOX 1,(27*8)-10,639,(32*8) ! schwarze Box
COLOR 0 ! grau
PBOX 6,(27*8)-7,633,(28*8)+4 ! graue Box
PBOX 6,(29*8)+2,633,(32*8)-4 ! 2. graue Box
COLOR 4 ! hellgrau
BOX 7,(27*8)-7,633,(32*8)-3
LINE 7,(29*8)+2,633,(29*8)+2
LINE 16,(29*8)-6,639-16,(29*8)-6
LINE 16,(29*8)+5,639-16,(29*8)+5
LINE 639-16,(29*8)-6,639-16,(26*8)+4 ! senkrechter Strich
LINE 16,(29*8)+5,16,(31*8)+2 ! senkrechter Strich
COLOR 2 ! schwarz
LINE 7,(32*8)-3,633,(32*8)-3 ! schwarze Linie
LINE 633,(27*8)-7,633,(32*8)-3
LINE 16,(27*8)-4,639-16,(27*8)-4
LINE 16,(31*8)+2,639-16,(31*8)+2
LINE 16,(29*8)-6,16,(26*8)+4 ! senkrechter Strich
LINE 639-16,(29*8)+5,639-16,(31*8)+2 ! senkrechter Strich
RETURN
PROCEDURE init ! Bildschirm öffnen
breite%=640 ! Screenbreite
hoehe%=256 ! Screenhöhe
ebenen%=3 ! 3 Bitplanes
OPENS 1,0,0,breite%,hoehe%,ebenen%,&H8000
OPENW #1,0,0,breite%,hoehe%,&H18,&H1800,1
farben.setzen ! Farbpalette setzen
RETURN
PROCEDURE farben.setzen ! Farben für Bildschirm
SETCOLOR 0,5,5,5 ! grau statt blau
SETCOLOR 1,15,15,15 ! weiß bleibt
SETCOLOR 2,0,0,0 ! schwarz erhalten
SETCOLOR 3,15,5,0 ! rot bleibt
SETCOLOR 4,10,10,10 ! hellgrau inverse Farbe im Filerequester
SETCOLOR 5,15,15,0 ! gelb
SETCOLOR 6,0,0,0 ! schwarz = Inverse Farbe im Filerequester
RETURN
PROCEDURE programmauswahl(titel$,oktext$,VAR pfad$,dateiname$)
CLR abbruch% ! Abbruchflag löschen
FILESELECT titel$,oktext$,pfad$,dateiname$
pos1%=RINSTR(dateiname$,"/")
pos2%=RINSTR(dateiname$,":")
IF pos1%>0 THEN ! Dateipfad herausfiltern
pfad$=MID$(dateiname$,1,pos1%)
dateiname$=MID$(dateiname$,pos1%+1)
ELSE IF pos2%>1 AND pos1%=0 ! Laufwerk nach Drive$()
pfad$=LEFT$(dateiname$,pos2%)
dateiname$=MID$(dateiname$,pos2%+1)
ENDIF
IF dateiname$="" OR RIGHT$(dateiname$,5)<>".info" THEN
abbruch%=1 ! Abbruchflag setzen
ENDIF
RETURN
REM ! damit beim Kopieren der Interpreter nicht
REM ! abstürzt